R Notebook

Reasons for the media sources chosen: News 24 : Recognized by APP Annie (App Annie is the standard in app analytics and app market data) as the most known South African internet media source. (Chinese Academy of Cyberspace Studiespublisher=Springer (15 September 2018). World Internet Development Report 2017: Translated by Peng Ping. p. 203. ISBN 9783662575246. OCLC 1052766508.)

Times Live : Claim to be South Africa’s second-biggest news website, published by Arena Holdings (Times Live website). No evidence found to disprove this claim. In top 10 of most visited publication websites for South Africa.

EWN : Not much info but it can be considered to be popular because it originated from 2 radio stations (KFM and CapeTalk), Makes it a popular and people hear about it without actively having to go and search for the news agency themselves. In top 10 of most visited publication websites for South Africa.

eNCA: Not much info but seems popular. Used to E News from TV channel. Might not be as trustworthy as there has been complaints about racism recently. In top 10 of most visited publication websites for South Africa.

SABC: National news company with government ties. Reaches a wide variety of viewers in different languages. The company is both state owned and a public broadcaster company.https://www.businesslive.co.za/bd/national/media/2015-05-20-sabc-both-state-owned-company-and-public-broadcaster-minister-says/

Chapter 10 of the Constitution of the Republic of South Africa, 1996 makes provision for good governance of news media and what they publish.

The other 4 of the 5 is ranked among the top 10 most visited publication sites websites in south africa as found by https://mybroadband.co.za/news/internet/358453-here-are-south-africas-most-popular-news-websites.html. These sites are the first sites on the top 10 list of publication sites that include general news along with news about covid-19 that do not have major historical issues that could bring their credibility in question. Reasons that other news or publishing sources that are ranked higher were not used is due to the fact that these sources either only focus on specific news like new technology or financial aspects, or these sources are not as popular throughout the whole of South Africa.

Importing Libraries

library(tidytext)
library(tidyverse)
library(textdata)
library(sentimentr)
library(stringr)
library(stringi)
library(rtweet)
library(ggplot2)
library(tidyr)
library(dplyr)
library(scales)
library(readr)
library(lubridate)
library(topicmodels)
library(quanteda)
library(reshape2)
library(zoo)

Importing data of collected tweets. This was done to see which lexicon works best between VADER and SentimentR

media_agency_df <- read_csv("data_in/media_agency_tweets.csv")
media_agency_df <- media_agency_df[ , colSums(is.na(media_agency_df)) < nrow(media_agency_df)]
media_agency_df <- media_agency_df %>% mutate("X1" = row_number())

Wrangeling and cleaning data

#Cleaning data
media_agency_df <- media_agency_df %>%
  mutate(text = gsub(" ?(f|ht)tp(s?)://(.*)[.][a-z]+", "", text),
         text = gsub("&amp", "", text),
         text = gsub("(RT|via)((?:\\b\\W*@\\w+)+)", "", text),
         text = gsub("@\\w+", "", text),
         text = gsub("[[:punct:]]", "", text),
         text = gsub("[[:digit:]]", "", text),
         text = gsub("http\\w+", "", text),
         text = gsub("[ \t]{2,}", "", text),
         text = gsub("^\\s+|\\s+$", "", text),
         text = gsub("&amp", "", text)) %>%
  mutate(text = str_replace_all(text," "," "),
         text = str_replace_all(text,"RT @[a-z,A-Z]*: "," "),
         text = str_replace_all(text,"#[a-z,A-Z]*"," "),
         text = str_replace_all(text,"@[a-z,A-Z]*"," "))


#tidying data
tidy_covid_media_df <- media_agency_df %>%
  #filter(str_detect(text, fixed(covid_dictionary, ignore_case = TRUE))) %>%
  filter(!str_detect(text, "^RT")) %>%
  mutate(text = gsub(" ?(f|ht)tp(s?)://(.*)[.][a-z]+", "", text)) %>%
  unnest_tokens(word, text, token = "tweets") %>%
  filter(!word %in% stop_words$word,
         !word %in% str_remove_all(stop_words$word, "'"),
         str_detect(word, "[a-z]"),
         !(word =="#sabcnews" |
             word =="#enca" |
             word =="https" |
             word =="#dstv403" |
             word =="t.co" |
             word =="rt" |
             word =="amp"))

#finding the screen names of media angencies
agencies<- media_agency_df %>%
  select(screen_name) 
agencies %>%
  distinct(screen_name)

Seniment Analysis with SentimentR

mytext<- media_agency_df 

mytext <- get_sentences(mytext$text)
sr_data <-sentiment(mytext)
#write_csv(sr_data,"data_in/sentimentr_data.csv")

Adding time data to sentiment df

time_data <- media_agency_df %>%
  select(X1,created_at,screen_name)

SentiR_data <-left_join(time_data,sr_data,
                        by=c("X1"="element_id"))
#write_csv(SentiR_data,"data_in/sr_df_time.csv")

Modeling the time data

#setting the date format
#NB only run date format once
SentiR_data$created_at = ymd_hms(SentiR_data$created_at)
#filtering by news agency
news24<- SentiR_data %>%
  filter(screen_name=="News24")

times_live<-SentiR_data %>%
  filter(screen_name=="TimesLIVE")

dailymaverick<-SentiR_data %>%
  filter(screen_name=="dailymaverick")

sabc<-SentiR_data %>%
  filter(screen_name=="SABCNews")

eNCA<-SentiR_data %>%
  filter(screen_name=="eNCA")

Graphs plotting the sentiment of the different news agencies over time. As one can see, they all tend to maintain a neutral stance with some fluctuations at time.

#graph for News24 sentiment over time
ggplot(data=news24, aes(x=created_at, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  facet_wrap(~screen_name) +
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))

#graph for Times Live sentiment over time
ggplot(data=times_live, aes(x=created_at, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  facet_wrap(~screen_name) +
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))

#graph for EWN sentiment over time
ggplot(data=dailymaverick, aes(x=created_at, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  facet_wrap(~screen_name) +
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))

#graph for eNCA sentiment over time
ggplot(data=eNCA, aes(x=created_at, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  facet_wrap(~screen_name) +
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))

#graph for SABC sentiment over time
ggplot(data=sabc, aes(x=created_at, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  facet_wrap(~screen_name) +
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))

Topic Modelling

tidy_matrix <- tidy_covid_media_df %>% count(screen_name, word) %>% cast_dfm(screen_name, word, n)

 
media_lda <- LDA(tidy_matrix, k = 4, control = list(seed = 1234))
media_lda
media_topics <- tidy(media_lda, matrix = "beta")
media_topics
media_top_terms <- media_topics %>%
group_by(topic) %>%
slice_max(beta, n = 10) %>%
ungroup() %>%
arrange(topic, -beta)
 

media_top_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(beta, term, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
scale_y_reordered()

Vader stuff. Here we created a dictionary with covid related terms that are commonly used to help us search through the dataframes for relevent tweets and posts.

vader_data<- read_csv("data_in/vader_df.csv")

covid_dictionary <- c("herd", "immunity", "incubation", "job", "loss", "Kits", "lockdown", "mask", "N95", "outbreak", "pandemic", "quarantine", "recovery", "sanitiser", "transmission", "Underlying", "conditions", "Ventilators", "WHO", "xenophobia", "youTube", "zoonotic", "stay-at-home", "covid", "coronavirus", "hyrdoxychloroquine", "asymptomatic", "frontline", "virus", "self-isolation", "disinfectant", "shelter-in-place", "masks", "SARS-CoV-2", "ICU", "corona", "reopen", "distancing", "covering", "furlough", "tracer", "easing", "remdesivir", "mail-in", "hornet", "antibody", "in-person", "defund", "racism", "looting", "loot", "reopen", "two-metre", "pandemic", "looter", "distancing", "dexamethasone", "racial", "vaccine",
                      "curfew","johnssons","astrazeneca","hospitals","social-distance",
                      "social-distancing","police","regulations","symptoms","testing",
                      "positive-tests","negative-tests","confirmed-cases","restrictions",
                      "deaths","infected","recoveries","level","jobs","unemployed",
                      "doctors","infections","sanitise","sanitiser","sanitisation",
                      "containment")

More libraries

library(XML)
library(RCurl)
library(RColorBrewer)
library(wordcloud)

Setting up Reddit scraper

Kyle’s Reddit code that he graciously gave to me :) I attempted 2 other reddit web scraping methods for scraping comments from post but they were unsuccessful. We settled instead to just focus on the posts themselves about Covid-19 in South Africa. By scraping the r/southafrica subreddit we managed to find about 250 posts dating back to last year December which would be from when South Africa was entering harder lockdown times again. We expect that due to the fact that this is the post themselves and not the comment sof people that the sentiment would be close to neutral or will have tendencies to return to neutral if it deviates from it. We will be making use of a 7 day rolling average to see the sentiment of the reddit posts as well a smooth graph to see the tendency of the posts sentiment over time.

Reddit post data

library(RedditExtractoR)

reddit_Covid_data<-RedditExtractoR::reddit_urls(search_terms = "Covid-19", subreddit = "southafrica",page_threshold = 10)

Cleaning Reddit post data

reddit_Covid_data <- reddit_Covid_data %>%
  mutate(title = gsub(" ?(f|ht)tp(s?)://(.*)[.][a-z]+", "", title ),
         title  = gsub("&amp", "", title ),
         title  = gsub("(RT|via)((?:\\b\\W*@\\w+)+)", "", title ),
         title = gsub("@\\w+", "", title ),
         title  = gsub("[[:punct:]]", "", title ),
         title  = gsub("[[:digit:]]", "", title ),
         title  = gsub("http\\w+", "", title ),
         title  = gsub("[ \t]{2,}", "", title ),
         title  = gsub("^\\s+|\\s+$", "", title ),
         title  = gsub("&amp", "", title )) %>%
  mutate(title  = str_replace_all(title ," "," "),
         title  = str_replace_all(title ,"RT @[a-z,A-Z]*: "," "),
         title  = str_replace_all(title ,"#[a-z,A-Z]*"," "),
         title  = str_replace_all(title ,"@[a-z,A-Z]*"," "))
write_csv(reddit_Covid_data,"data_in/reddit_SA.csv")

reddit_Covid_data$date= dmy(reddit_Covid_data$date)
reddit_Covid_data<- reddit_Covid_data %>% mutate("X1"=row_number())

Sentiment of reddit posts using SentimentR

sd<- get_sentences(reddit_Covid_data$title)
reddit_sentiment<- sentiment(sd)

reddit_sentiment<- left_join(reddit_Covid_data,reddit_sentiment,
                             by=c("X1"="element_id"))

Modeling Reddit sentiment over time

ggplot(data=reddit_sentiment, aes(x=date, y=rollmean(sentiment, 30,  na.pad=TRUE))) +
       geom_line(color="pink", size=.5)+
  geom_smooth() +
  theme_minimal()+
  scale_y_continuous(expand = c(0,0), breaks = c(-0.4,-0.2,0,0.2,0.4)) +
  ylim(c(-0.4, 0.4))+
  labs(title = "Sentiment from the titles of Reddit post about Covid in SA", x="Date", 
       y="Sentiment")

As can be seen from the graph the sentiment of the posts started out more negative and that would correlated to be around to higher infections per day. The sentiment does have a positive trend towards the end of the wave of infections. Even though there is very slight fluctuations the posts seem mostly neutral.

What follows is the modeling of the comment sections of many of the posts we found. The Reddit hole of comments. All who enter, beware! Here we create a dataframe from comments made by users on posts that have the topic of Covid-19

library(rtweet)
library(ggplot2)
library(tidyr)
library(dplyr)

Attaching package: ‘dplyr’

The following objects are masked from ‘package:stats’:

    filter, lag

The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union

library(tidytext)
library(stringr)
library(scales)
library(readr)

Attaching package: ‘readr’

The following object is masked from ‘package:scales’:

    col_factor

library(lubridate)

Attaching package: ‘lubridate’

The following objects are masked from ‘package:base’:

    date, intersect, setdiff, union

library(vader)
library(topicmodels)
library(quanteda)

Package version: 3.0.0
Unicode version: 13.0
ICU version: 69.1
Parallel computing: 8 of 8 threads used.
See https://quanteda.io for tutorials and examples.

library(lubridate)
library(zoo)

Attaching package: ‘zoo’

The following object is masked from ‘package:quanteda’:

    index

The following objects are masked from ‘package:base’:

    as.Date, as.Date.numeric

library(plotly)

Registered S3 method overwritten by 'data.table':
  method           from
  print.data.table     
Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

library(forcats)
library(igraph)

Attaching package: ‘igraph’

The following object is masked from ‘package:plotly’:

    groups

The following objects are masked from ‘package:lubridate’:

    %--%, union

The following objects are masked from ‘package:dplyr’:

    as_data_frame, groups, union

The following object is masked from ‘package:tidyr’:

    crossing

The following objects are masked from ‘package:stats’:

    decompose, spectrum

The following object is masked from ‘package:base’:

    union

library(ggraph)
library(widyr)
library(qdapRegex)

Attaching package: ‘qdapRegex’

The following object is masked from ‘package:dplyr’:

    explain

The following object is masked from ‘package:ggplot2’:

    %+%

library(magick)

Linking to ImageMagick 6.9.12.3
Enabled features: cairo, fontconfig, freetype, heic, lcms, pango, raw, rsvg, webp
Disabled features: fftw, ghostscript, x11

Here we found a way to get the comment of the Reddit posts that were modeled earlier.

comments<- get_reddit(search_terms = "Covid-19", subreddit = "southafrica", page_threshold = 5,
                      sort_by = "new")
write_csv(comments, "data_in/reddit_comments.csv")

We first clean the original text to remove links, punctuation, digits, links, @’s. Then we tokenize the comments and remove stop words from tidytext and our own stopword dictionary. We also use the “twitter” token to handle any left over @’s and URLS.

From our tidied comment dataset, we look for the top words that appear. This will give us a good idea of what most people comment about. We find that most people talk about other people usually in conjunction with other words like vaccines or covid.

#top words
top_words <- tidy_reddit_df %>%
  anti_join(stop_words) %>%
  count(word) %>%
  arrange(desc(n))

Joining, by = "word"

top_words %>%
  slice(1:20) %>%
  ggplot(aes(reorder(word,-n), n, fill = word)) +
  geom_bar(stat = "identity") +
  theme_minimal() +
  theme(
    axis.text.x = element_text(
      angle = 60,
      hjust = 1,
      size = 13
    ),
    plot.title = element_text(hjust = 0.5, size = 18)
  ) +
  ylab("Frequency") +
  xlab ("") +
  ggtitle("Most frequent words used in reddit comments") +
  guides(fill = FALSE)

Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> = "none")` instead.

After changing, adding, and removing terms from the filters, we can conclude that the tf-idf anaylsis is not useful for these comments. The simple amount of comment data per post and the fact that the time frames are sporadic make that you are unable to . When tf-idf runs, it increases their term weights as they are “unique” because they are not found among other media agencies. These words are usually not telling. What it can tell us - which segments these media agencies post about the most.

#tf-idf
tidy_reddit_tf_idf <- tidy_reddit_df %>%
  select(author, word) %>%
  group_by(author) %>%
  count(word, author) %>%
  bind_tf_idf(word, author, n)

#calculate a frequency for each agency and word
frequency <- tidy_reddit_tf_idf %>%
  group_by(author) %>%
  count(word, sort = TRUE) %>%
  left_join(tidy_reddit_df %>%
              group_by(author) %>%
              summarise(total = n())) %>%
  mutate(freq = n / total)

Joining, by = "author"

tidy_reddit_tf_idf %>%
  group_by(author) %>%
  slice_max(tf_idf, n = 15) %>%
  ungroup() %>%
  ggplot(aes(tf_idf, fct_reorder(word, tf_idf), fill = author)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ author, ncol = 2, scales = "free") +
  labs(x = "tf-idf", y = NULL)

By modeling bigrams and trigrams for our dataset gives us a better understanding of what topic is being discussed with each word. We can then also see which sentiments are incorrectly labeled. “not good” gives better context of a negative sentiment, rather than it being incorrectly identified as positive good. Although this works really well for Twitter, it does not seems to carry through that well to the point of interpretation for Reddit data.

#bigrams
tidy_bigram_df <- reddit_comments_df %>%
  #filter(str_detect(text, fixed(covid_dictionary, ignore_case = TRUE))) %>%
  filter(!str_detect(comment, "^RT")) %>%
  mutate(comment = gsub(" ?(f|ht)tp(s?)://(.*)[.][a-z]+", " ", comment)) %>%
  unnest_tokens(bigram, comment, token = "ngrams", n = 2) %>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigrams_filtered <- tidy_bigram_df %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word)

# new bigram counts:
bigram_counts <- bigrams_filtered %>%
  count(word1, word2, sort = TRUE)

bigrams_united <- bigrams_filtered %>%
  unite(bigram, word1, word2, sep = " ")

#tf-idf bigrams
bigram_tf_idf <- bigrams_united %>%
  count(author, bigram) %>%
  bind_tf_idf(bigram, author, n) %>%
  arrange(desc(tf_idf))

bigram_tf_idf %>%
  group_by(author) %>%
  slice_max(tf_idf, n = 15) %>%
  ungroup() %>%
  ggplot(aes(tf_idf, fct_reorder(bigram, tf_idf), fill = author)) +
  geom_col(show.legend = FALSE) +
  facet_wrap( ~ author, ncol = 2, scales = "free") +
  labs(x = "tf-idf", y = NULL)

#weights and graphs
bigram_graph <- bigram_counts %>%
  filter(n > 100) %>%
  graph_from_data_frame()

set.seed(1234)
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
  geom_edge_link(
    aes(edge_alpha = n),
    show.legend = FALSE,
    arrow = a,
    end_cap = circle(.07, 'inches')
  ) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name),
                 vjust = 1,
                 hjust = 1,
                 repel = TRUE) +
  theme_void()

Don't know how to automatically pick scale for object of type function. Defaulting to continuous.
Error: Aesthetics must be valid data columns. Problematic aesthetic(s): edge_alpha = n. 
Did you mistype the name of a data column or forget to add after_stat()?
Run `rlang::last_error()` to see where the error occurred.

We give more weight to words that appear more often with the incorrect sentiment. We can now reverse the sentiment of these words once VADER has been run on the dataset.

#vader lexicon imported from VADER GitHub
vader_lexicon <- read_csv2("data_in/vader_lexicon.csv") %>%
  rename("word" = TOKEN, "value" = `MEAN-SENTIMENT-RATING`)

ℹ Using "','" as decimal and "'.'" as grouping mark. Use `read_delim()` for more control.

── Column specification ─────────────────────────────────────────────────────────────────────
cols(
  TOKEN = col_character(),
  `MEAN-SENTIMENT-RATING` = col_character(),
  `STANDARD DEVIATION` = col_character(),
  `RAW-HUMAN-SENTIMENT-RATINGS` = col_character()
)

#common negation words
negation_words <-
  c(
    "not",
    "no",
    "never",
    "without",
    "no",
    "not",
    "none",
    "no one",
    "nobody",
    "nothing",
    "neither",
    "nowhere",
    "never",
    "doesn’t",
    "isn’t",
    "wasn’t",
    "shouldn’t",
    "wouldn’t",
    "couldn’t",
    "won’t",
    "can’t",
    "don’t"
  )
negated_words <- tidy_bigram_df %>%
  filter(word1 %in% fixed(negation_words, ignore_case = TRUE)) %>%
  inner_join(vader_lexicon, by = c(word2 = "word")) %>%
  mutate(value = as.double(value)) %>%
  count(word1, word2, value, sort = TRUE) %>%
  mutate(contribution = n * value) %>%
  arrange(desc(abs(contribution))) %>%
  mutate(word2 = reorder(word2, contribution))
negated_words %>%
  head(40) %>%
  ggplot(aes(n * value, word2, fill = n * value > 0)) +
  geom_col(show.legend = FALSE) +
  facet_wrap( ~ word1, scales = "free_y") +
  labs(x = "Sentiment value * # number of occurrences",
       y = "Words preceded by negation terms")

The graph below shows which words are most likely to co-occur. We use this to understand the context of words in our topic modelling.

reddit_comments_section_words <- tidy_reddit_df %>%
  mutate(section = row_number() %/% 10) %>%
  filter(section > 0)

# count words co-occuring within sections
word_pairs <- reddit_comments_section_words %>%
  pairwise_count(word, section, sort = TRUE)

# we need to filter for at least relatively common words first
word_cors <- reddit_comments_section_words %>%
  group_by(word) %>%
  filter(n() >= 20) %>%
  pairwise_cor(word, section, sort = TRUE)%>%
  filter(correlation>=.05)
   
  

# Correlation of next word
# word_cors %>%
#   filter(item1 == "vaccine")

word_cors %>%
  filter(item1 %in% c("covid", "vaccine", "lockdown", "zuma", "gauteng", "ramaphosa")) %>%
  group_by(item1) %>%
  slice_max(correlation, n = 6) %>%
  ungroup() %>%
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_bar(stat = "identity") +
  facet_wrap( ~ item1, scales = "free") +
  coord_flip() 

  

set.seed(1234)
word_cors %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation),
                 show.legend = FALSE,
                 edge_width = 3) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()

What we noticed here is that alot of the data is difficult to model due to the size and the amount of different posts. What we can however see is that more recent tweets seem to have a more negative compound sentiment value than tweets from earlier this year.

#vader_df <- vader_df(reddit_comments_df$comment)
#write_as_csv(vader_df, "data_in/vader_reddit_comments")

 

vader_df <- read_csv("data_in/vader_reddit_comments.csv")

── Column specification ─────────────────────────────────────────────────────────────────────
cols(
  text = col_character(),
  word_scores = col_character(),
  compound = col_double(),
  pos = col_double(),
  neu = col_double(),
  neg = col_double(),
  but_count = col_double()
)

vader_df <- vader_df %>% mutate("X1" = row_number())
reddit_comments_df <- reddit_comments_df %>% mutate("X1" = row_number())
reddit_comments_vader <- reddit_comments_df %>% left_join(vader_df, by = "X1")

#General sentiment over time. Media agencies seem to have an even number of positive and negative tweets per day.
ggplot(
  reddit_comments_vader %>%
    mutate(post_date = as.Date(post_date)) %>%
    group_by(post_date, author) %>%
    mutate(compound = replace(compound, is.na(compound), 0)) %>%
    summarise(sum_compound = sum(as.double(compound))),
  aes(post_date, sum_compound, fill = author)
) +
  geom_bar(stat = "identity") +
  geom_smooth(method = "lm", na.rm = TRUE, se = FALSE) +
  facet_wrap( ~ author, scales = "free_x", ncol = 2) +
  theme_minimal() +
  scale_y_continuous(expand = c(0, 0)) +
  scale_x_date(date_breaks = "3 day", date_labels = "%m-%d") +
  theme(
    axis.text.x = element_text(
      angle = 90,
      vjust = 0.5,
      hjust = 1
    ),
    panel.grid.minor.y = element_blank(),
    panel.grid.minor.x = element_blank(),
  )

`summarise()` has grouped output by 'post_date'. You can override using the `.groups` argument.

`geom_smooth()` using formula 'y ~ x'

ggplot(
  reddit_comments_vader %>%
    mutate(post_date = as.Date(post_date)) %>%
    group_by(post_date) %>%
    filter(author == "angel_yellow_brick") %>%
    summarise(compound),
  aes(post_date, compound)
) +
  geom_bar(stat = "identity") +
  geom_smooth(method = "lm", na.rm = TRUE) +
  theme_minimal() +
  scale_y_continuous(expand = c(0, 0))

`summarise()` has grouped output by 'post_date'. You can override using the `.groups` argument.

`geom_smooth()` using formula 'y ~ x'

#News sentiment
reddit_comments_vader %>%
  mutate(post_date = as.Date(post_date)) %>%
  group_by(post_date, author) %>%
  summarise(compound) %>%
  arrange(desc(compound))

`summarise()` has grouped output by 'post_date', 'author'. You can override using the `.groups` argument.

ggplot(reddit_comments_vader %>% arrange(compound) %>% mutate(X1 = factor(X1, levels = X1)),
       aes(x = X1)) +
  geom_point(mapping =  aes(y = compound)) +
  theme_minimal() +
  scale_y_continuous(expand = c(0, 0))

Warning: Removed 6 rows containing missing values (geom_point).

reddit_comments_vader%>%
  mutate(post_date = as.Date(post_date, format = "%d-%m-%y")) %>%
  group_by(post_date, author) %>%
  mutate(compound = replace(compound, is.na(compound), 0)) %>%
  summarise(sum_compound = sum(as.double(compound)))

`summarise()` has grouped output by 'post_date'. You can override using the `.groups` argument.

The plot below maps the average total comments on a post per day.

Our main topic influence is COVID-19 as this is what currently affects the country the most. We based our data collection around the word COVID-19 and expect to see a lot of inter related terms about it spread throughout the different topics. As you can see, due to the fact that the posts were all about Covid, the comments all inherited the overarching topic.

tidy_matrix <-
  tidy_reddit_df %>% sample(tidy_reddit_df, size=0.1) %>% count(author, word) %>% cast_dfm(author, word, n)

Error in FUN(left) : invalid argument type

We determine the correct number of topics in mechanisms like the LDA (Latent Dirichlet Allocation) as they determine the quality of features of the words.

A topic model is a type of statistic model for discovering the abstract “topics” that occur in a collection of documents.

Topic modeling is used to classify and retrieve information. These models capture word correlations in a collection of textual documents with topics. It is very difficult to pick the right number of topics for a specific dataset. It is important to determine the value of ‘k’.

The importance of the value of ‘k’ is to ensure you do not over estimate or underestimate the data. If you over estimate it, you will be left with topics that carry very little meaning and if you under estimate the data, you will lose out on topics that could have been useful to your research.

By looking at the lowest minimum and the highest maximum, we can determine the ‘k’. This is how we have interpreted the graphs produced. Griffiths2004 is not informative in this situation and is therefore ignore

This method used has been proved to produce the best results of LDA without having to manually tune the ‘k’ value.

library("ldatuning")
library("topicmodels")

data("AssociatedPress", package = "topicmodels")
dtm <- AssociatedPress[1:10,]

result <- FindTopicsNumber(
  tidy_matrix,
  topics = seq(from = 2, to = 15, by = 1),
  metrics = c("Griffiths2004", "CaoJuan2009", "Arun2010", "Deveaud2014"),
  method = "Gibbs",
  control = list(seed = 77),
  mc.cores = 2L,
  verbose = TRUE
)

fit models... done.
calculate metrics:
  Griffiths2004...